home *** CD-ROM | disk | FTP | other *** search
/ Netware Super Library / Netware Super Library.iso / menu_pgm / mcmenu / mcmenu.pas < prev    next >
Pascal/Delphi Source File  |  1992-08-22  |  34KB  |  1,140 lines
  1. PROGRAM MCMenu;
  2. { ver 0.000
  3.           ^ bug fix
  4.         ^^  minor rev
  5.       ^     major rev
  6. { Turbo Pascal 5.5 }
  7.  
  8. { Malaspina College Menu     }
  9. { ALL work done on MY time, as was original concept.  }
  10. { 0.100 work start Nov  18 1991  Tony Bigras  BIGRAS@MALA.BC.CA
  11.                                               (604) 753-3245 x2588 }
  12. { 0.708 seems ok menu wise most bugs out ( the ones I know about )
  13.  
  14.   0.710 another bug in submenus with data going to end of file fixed
  15.   adjusted calcfloatindex for N+ switch I had put it around func
  16.   but it has to be global.  That picked up 10k of .exe
  17.  
  18.     0.711 fixed bug with empty lines in menu file causing
  19.     invalid menu message
  20.  
  21.     0.712 turn off cursor so menu looks cleaner
  22.           turned on again at end of prog with call to co80
  23.  
  24.     0.713 mouse support for microsoft mouse type
  25.           left button = RETURN
  26.           right button = ESC
  27.           up and down = up down keys
  28.           no mouse pointer just key translation
  29.  
  30.     0.714 Monitor to full screen width
  31.           Prompt on main screen for F1 for help
  32.           Check DOS version min 3.00
  33.     0.715 figure out name of this program for
  34.           appending to end of alt255.bat file.
  35.           only partial work done
  36.     0.716 no esc character on last line '!' was being added
  37.           to last menu item.
  38.     0.717 mono card colour selections and detection
  39.           it was giving underlines for many items (blue background)
  40.     0.718 padded time with 0's
  41.           only display esc from main menu in help if avail
  42.  
  43.           initial implementation will be only for advertised RPC's
  44.           no downloaded code only resident code
  45.           just download and upload data
  46.           so all resident RPC's use a single pointer to a structure
  47.           in the interface of the RPCUnit
  48.     0.719 adding in netbios hooks
  49.           also boosted intcalc to get 1 on pc 4.77mhz
  50.     0.720 tuned mouse response in SYSSUP
  51.     0.721 little bug with lack of key buffering in SYSSUP
  52.     0.722 little bug in not displaying exit errors
  53.     0.723 adjust netbios detect to compare for unused vectors as well
  54.     0.724 move blank interval to 3 minutes and blank move to 5 sec
  55.     0.725 put move interval onto regular interval start ie 0 5 10 15etc
  56.     0.726 switched from alt255.bat to X.bat to allow novell to flag
  57.           file x.bat when deleting others in directory.
  58.  
  59.     should add total temp convert to upper case in menu match
  60.     testing in getinfo.  currently wont match Hello and hello
  61.     0.727 more mouse tuneing
  62.     0.728 ""
  63.     0.729 added mcmenu ver to blanker screen
  64.     0.800 reduced program heap size to prevent command.com
  65.           transient portion being forced out
  66.           added extended last line controls not just no escape
  67.           ! or !! is no escape
  68.           !R is enable RPC
  69.           !!R no escape + enable RPC
  70.  
  71.     0.801 turned off rpcstatus if not rpcok
  72.     0.900 multi nested menus  4000 lines and 200 menus  20 items/menu
  73.     0.901 recurseive menu structures
  74.           widened menus to 76 characters with error trimming
  75.     0.902 integrated menu and sub menu execution into single function
  76.     0.910 added support for 21 items / menu and alpha keying of menu selection
  77.           better error trapping on file r/w
  78.           improved error messages
  79.     0.911 bug in sub menus, they are displaying locator info: fixed
  80.     0.930 RPC monitor removed, debug code removed
  81.           no functional changes
  82.     1.000 First release with source code.
  83.           RPC interface describe in docs but not implemented here.
  84.     1.001 alpha keying bug fixed
  85.     1.002 dos 5.0 reading past end of X.bat fixed
  86.     1.010 use dos param(0) to figure name and path of menu program
  87.           to write to batch file.  Also search program directory
  88.           first for menu data file. If not found turn over to DOS
  89.           search mechanism.
  90.     1.011 Internal Malaspina College mod with 'tuesday'
  91.           spelling fix and change to noise with error
  92.           in input file.
  93.  
  94.     1.1 - 1.4 reserved for public mods
  95.  
  96.  
  97.     1.500 Addeed Launch Logger hard coded to S:\LOG\LOG>TXT
  98.           with reference  to USRN env variable and with the ability
  99.           to log program launches. Uses the !L control
  100.  
  101.     1.510 Ability to not include menu
  102.           rerun line at end of batch file.
  103.           IF !MC! is at begining of line then that plus
  104.           one space are stripped and final line of bat
  105.           file is not the menu name etc.  This is usefull
  106.           for switching between multiple menus as it
  107.           does not let leftover batch file parts interfere
  108.           with the transfer.
  109.  
  110.     1.520 added a space to right side of menu items for better
  111.           viewing. Change blank start time to 5 minutes.
  112.           and added !M to allow menu to return to last item
  113.           ' SEE DOCS '
  114. }
  115. { Public Domain, Absolutly NO liability accepted!                 }
  116. { Processes Novell type menu  using 0k with Hard drive menu ability}
  117. { and hooks to Remote Procedure Calls }
  118. { Uses Novell menu script but ignores colours, menu locators }
  119. { need more features, you have the source.    }
  120. { NOTE uses Env Var MN to name menu to use or Command Line overide }
  121.  
  122. USES Crt,Dos,Win,SysSup,TextMenu;
  123.  
  124. {L Win }
  125. {L SysSup}
  126. {L TextMenu }
  127. { 0.800 }
  128. {$M 32768,100000,100000}
  129.  
  130. CONST
  131.   verstr  = '1.520';
  132.   blanks  = '                                                                     ';
  133.   { 0.900 }
  134.   maxdata= 4000;
  135.   maxmenu=200;
  136.   { 0.726 }
  137.   fnamechar='X';
  138.  
  139. TYPE
  140.   menunumtype= 0..maxmenu;
  141.   mcmenutype= RECORD
  142.                 num: 1..mxonmenu;
  143.                 strs: ARRAY[0..mxonmenu+1] OF 1..maxdata; { +1 to find end of item }
  144.                 issub: ARRAY[1..mxonmenu] OF BOOLEAN;
  145.                 menuidx: ARRAY[1..mxonmenu] OF menunumtype;
  146.               END;
  147.  
  148. VAR
  149.   escapeok,escaped: BOOLEAN;
  150.  
  151.  
  152.   ch: CHAR;
  153.   ttlscr: winrecptr;
  154.   curhelp: STRING;
  155.   reg: REGISTERS;
  156.   oldhelpvec,oldhk2vec: POINTER;
  157.   cnt,maxcnt: INTEGER;
  158.   filestr: STRING;
  159.   mdatastr: ARRAY[1..maxdata] OF ^STRING;
  160.   numdata: 1..maxdata;
  161.   menus: ARRAY[0..maxmenu] OF mcmenutype;
  162.   cl: BOOLEAN;
  163.   dosverstr: STRING[10];
  164.   totmenu: menunumtype;
  165.  
  166.   { 0.800 }
  167.   rpcok: BOOLEAN;
  168.   { 1.500 }
  169.   logon: BOOLEAN;
  170.   { 1.520 }
  171.   memoryon: BOOLEAN;  { put out info to return to same menu position }
  172.   outputmemorystr: STRING;
  173.   memorystr: STRING;
  174.              { format for locating on menu is 2 chars per menu,
  175.                with drops to lower menus indicated until end of
  176.                string.  Hence 100503  would be 10 on first menu
  177.                5 on second menu and 3 on third menu which is
  178.                where it would stay..  IF memorystr<>'' THEN
  179.                input is taken from the file 2 chars at a time }
  180.                { Just a hack , IF memorystr contains invalid
  181.                  values for a menu level it is cleared. }
  182.  
  183.  
  184.   PROCEDURE stufkeyp(codekey: INTEGER); EXTERNAL;
  185.  {$L STUFKEYP.OBJ}
  186.  
  187.   PROCEDURE titlemsg(title: STRING;VAR  wn: winrecptr);
  188.   VAR
  189.     attr: INTEGER;
  190.   BEGIN  {titlemsg}
  191.     openwindow(2,2,79,2,wn);
  192.     IF lastmode=mono THEN
  193.       attr:=darkgray+lightgray*16
  194.     ELSE
  195.       attr:= blue+cyan*16;
  196.  
  197.     fillwin(#32,attr);
  198.     writestr(1,1,title,attr);
  199.   END; { titlemsg }
  200.  
  201.  
  202.   PROCEDURE error(str: STRING);
  203.   VAR
  204.     i: INTEGER;
  205.   BEGIN  { error }
  206.     window(1,1,80,25);
  207.     textbackground(black);
  208.     textcolor(lightgray);
  209.     clrscr;
  210.     SETINTVEC(250,oldhelpvec);
  211.     SETINTVEC(251,oldhk2vec);
  212.     textmode(lastmode);
  213.     { 0.910 }
  214.     WRITELN;
  215.     WRITELN(CONCAT('MC Menu Ver ',verstr,'  E R R O R.'));
  216.     WRITELN;
  217.     WRITE('       ');
  218.     WRITELN(str);
  219.     WRITELN;
  220.     WRITELN;
  221.  
  222.     { 0.910 }
  223.     {
  224.     FOR i:= 1 TO 8 DO
  225.     BEGIN
  226.       sound(100);
  227.       delay(200);
  228.       sound(500);
  229.       delay(200);
  230.     END;
  231.     }
  232.     { 1.011 }
  233.     sound(500);
  234.     delay(300);
  235.     nosound;
  236.     HALT(1);
  237.   END; { error }
  238.  
  239.   PROCEDURE help;  INTERRUPT; { vector 250 }
  240.   CONST
  241.     helpattr= black+lightgray*16;
  242.  
  243.   VAR
  244.     helpwin: winrecptr;
  245.     oldwin: winstate;
  246.     i: INTEGER;
  247.     key: CHAR;
  248.     helphack: INTEGER;
  249.   BEGIN { help }
  250.     inhelp:= TRUE;
  251.     savewin(oldwin);
  252.     openwindow(1,4,80,25,helpwin);
  253.     tframewin('MC Menu Help',singleframe,helpattr,helpattr);
  254.     fillwin(#32, helpattr);
  255.     textattr:=helpattr;
  256.     gotoxy(1,1);
  257.     savewin(helpwin^.state);
  258.     GOTOXY(1,2);
  259.  
  260.     IF (curhelp='General') THEN helphack:=1;
  261.  
  262.     CASE helphack OF
  263.  
  264.       1: BEGIN
  265.         WRITELN;
  266.         WRITELN('           Items with a  »  have a sub menu.');
  267.         WRITELN;
  268.         WRITELN('           Select an item or a submenu by pressing the ENTER key.');
  269.         WRITELN;
  270.         WRITELN('           Choose different items using arrow or alpha keys. ');
  271.         WRITELN;
  272.         IF hasmouse THEN
  273.         BEGIN
  274.           WRITELN('           Mouse Active... left button = RETURN, right = ESC.');
  275.           WRITELN;
  276.         END; { hasmouse }
  277.         WRITELN('           Exit a submenu with the ESC key.');
  278.         WRITELN;
  279.         { 0.716 }
  280.         IF escapeok THEN
  281.           WRITELN('           Exit the Main Menu with the ESC key.');
  282.         WriteStr(16,17,
  283.           'Public Domain by Tony Bigras August 24 1992',
  284.           helpattr);
  285.       END { 1 };
  286.  
  287.     END; { CASE }
  288.     WriteSTr(26,19,'Press <ESC> to leave Help.',helpattr);
  289.     key:= allowkey([CHAR(esc)],-1);
  290.     restorewin(helpwin^.state);
  291.     unframewin;
  292.     closewindow(helpwin);
  293.     restorewin(oldwin);
  294.     inhelp:= FALSE;
  295.   END; { help }
  296.  
  297.   PROCEDURE titlescreen;
  298.   VAR
  299.     attr: INTEGER;
  300.     attrf1: INTEGER;
  301.   BEGIN { titlescreen }
  302.     openwindow(1,1,80,3,ttlscr);
  303.     IF lastmode=mono THEN
  304.     BEGIN
  305.       attr:= black+lightgray*16;
  306.       attrf1:=darkgray+black*16;
  307.     END
  308.     ELSE
  309.     BEGIN
  310.       attr:= blue+cyan*16;
  311.       attrf1:=white+blue*16;
  312.     END;
  313.     framewin(singleframe,attr);
  314.     WriteStr(1,1,'M C Menu                                                             Ver '+verstr+'  '
  315.      ,attr);
  316.     window(1,4,80,25);
  317.     fillwin(#177,attr);
  318.     WriteStr(1,22,
  319.      '<F1>-Help                                                                         '
  320.      ,attrf1);
  321.   END; { titlescreen }
  322.  
  323.   PROCEDURE domainmenu;
  324.  
  325.   CONST
  326.    fname= fnamechar+'.bat';
  327.  
  328.   VAR
  329.     f: TEXT;
  330.     i,choice: INTEGER;
  331.     menu: menutype;
  332.     selected: BOOLEAN;
  333.  
  334.  
  335.     { 1.500 }
  336.     PROCEDURE Writelog(application: STRING);
  337.  
  338.     CONST
  339.      trycount= 30;
  340.      flogname='S:\LOG\LOG.TXT';
  341.      maxtrydelay= 100;
  342.      mintrydelay= 20;
  343.  
  344.     VAR
  345.       f: TEXT;
  346.       delvar: INTEGER;
  347.       count: INTEGER;
  348.       logstr: STRING;
  349.       year,month,day,dayofweek: WORD;
  350.       s: STRING;
  351.       hour,minute,second,sec100: WORD;
  352.       i: INTEGER;
  353.       iores: INTEGER;
  354.  
  355.     BEGIN { Writelog }
  356.       logstr:=application;
  357.       IF LENGTH(logstr)<30 THEN
  358.         logstr:=CONCAT(logstr,COPY(blanks,1,30-LENGTH(logstr)))
  359.       ELSE
  360.         logstr:=COPY(logstr,1,30);
  361.  
  362.       logstr:= CONCAT(logstr,'  ',getenv('USRN'));
  363.       IF LENGTH(logstr)<40 THEN
  364.         logstr:=CONCAT(logstr,COPY(blanks,1,40-LENGTH(logstr)))
  365.       ELSE
  366.         logstr:=COPY(logstr,1,40);
  367.  
  368.       logstr:=CONCAT(logstr,'  ');
  369.  
  370.       GetDate(year,month,day,dayofweek);
  371.       CASE dayofweek OF
  372.         0: logstr:=CONCAT(logstr,'Sun');
  373.         1: logstr:=CONCAT(logstr,'Mon');
  374.         2: logstr:=CONCAT(logstr,'Tue');
  375.         3: logstr:=CONCAT(logstr,'Wed');
  376.         4: logstr:=CONCAT(logstr,'Thu');
  377.         5: logstr:=CONCAT(logstr,'Fri');
  378.         6: logstr:=CONCAT(logstr,'Sat');
  379.       END; { CASE }
  380.  
  381.       CASE month OF
  382.         1: logstr:= CONCAT(logstr,' Jan');
  383.         2: logstr:= CONCAT(logstr,' Feb');
  384.         3: logstr:= CONCAT(logstr,' Mar');
  385.         4: logstr:= CONCAT(logstr,' Apr');
  386.         5: logstr:= CONCAT(logstr,' May');
  387.         6: logstr:= CONCAT(logstr,' Jun');
  388.         7: logstr:= CONCAT(logstr,' Jul');
  389.         8: logstr:= CONCAT(logstr,' Aug');
  390.         9: logstr:= CONCAT(logstr,' Sep');
  391.        10: logstr:= CONCAT(logstr,' Oct');
  392.        11: logstr:= CONCAT(logstr,' Nov');
  393.        12: logstr:= CONCAT(logstr,' Dec');
  394.       END; { CASE }
  395.  
  396.       STR(day:2,s);
  397.       logstr:= CONCAT(logstr,' ',s);
  398.       STR(year:4,s);
  399.       logstr:= CONCAT(logstr,' ',s);
  400.       GetTime(hour,minute,second,sec100);
  401.       STR(hour:2,s);
  402.       FOR i:= 1 TO LENGTH(s) DO
  403.         IF s[i]= ' ' THEN
  404.           s[i]:='0';
  405.       logstr:= CONCAT(logstr,' ',s);
  406.       STR(minute:2,s);
  407.       FOR i:= 1 TO LENGTH(s) DO
  408.         IF s[i]= ' ' THEN
  409.           s[i]:='0';
  410.       logstr:= CONCAT(logstr,':',s);
  411.       STR(second:2,s);
  412.       FOR i:= 1 TO LENGTH(s) DO
  413.         IF s[i]= ' ' THEN
  414.           s[i]:='0';
  415.       logstr:= CONCAT(logstr,':',s);
  416.  
  417.       {$I-}
  418.       count:= 0;
  419.       REPEAT
  420.         ASSIGN(f,flogname);
  421.         delay(mintrydelay+Random(maxtrydelay-mintrydelay));
  422.         count:= count+1;
  423.         APPEND(f);
  424.         iores:=ioresult;
  425.  
  426.         { debug
  427.         writeln(iores,' ',flogname);
  428.         }
  429.  
  430.       UNTIL (iores=0) OR (count>trycount);
  431.  
  432.       { debug
  433.       IF count >trycount then
  434.       begin
  435.         writeln(trycount);
  436.         readln;
  437.       end;
  438.       }
  439.  
  440.  
  441.       WRITELN(f,logstr);
  442.       CLOSE(f);
  443.       {$I+}
  444.  
  445.     END; { Writelog }
  446.  
  447.  
  448.     PROCEDURE checkforparms(cnt: INTEGER);
  449.     CONST
  450.       maxparm= 9;
  451.     VAR
  452.       i,k: INTEGER;
  453.       tstr,tstr2: STRING[80];
  454.       parm: ARRAY[1..maxparm] OF STRING[80];
  455.       parmactive: ARRAY[1..maxparm] OF BOOLEAN;
  456.       parpos: INTEGER;
  457.  
  458.  
  459.       PROCEDURE winedit(wn: winrecptr; edbuf: pointer;
  460.             size: WORD; keys: keysettype;noscroll: BOOLEAN; exitchr: CHAR);
  461.       TYPE
  462.         tbuftype= ARRAY[0..65000] OF CHAR;
  463.       VAR
  464.         key: CHAR;
  465.         keysallowed: keysettype;
  466.         minx,miny,maxx,maxy: INTEGER;
  467.         curx,cury: INTEGER;
  468.         tptr: ^tbuftype;
  469.       BEGIN { edit }
  470.       tptr:=edbuf;
  471.       restorewin(wn^.state);
  472.       minx:=1;
  473.       miny:=1;
  474.       maxx:=(Lo(WindMax)-Lo(WindMin))+1;
  475.       maxy:=(Hi(WindMax)-Hi(WindMin))+1;
  476.       curx:=minx;
  477.       cury:=miny;
  478.       gotoxy(minx,miny);
  479.       keys:=keys+[CHR(up),CHR(down),CHR(left),CHR(right),
  480.                    CHR(esc),CHR(bs),CHR(return)];
  481.       REPEAT
  482.         key:= allowkey(keys,-1);
  483.         CASE key OF
  484.           CHR(32)..CHR(126):
  485.           BEGIN
  486.             GOTOXY(curx,cury);
  487.             IF (curx<>maxx) AND (cury<>maxy) THEN
  488.               Write(key)
  489.             ELSE
  490.               WriteChar(curx,cury,1,key, textattr);
  491.             tptr^[((cury-1)*(maxx+1))+curx-1]:=key;
  492.             IF curx<>maxx THEN
  493.               INC(curx)
  494.             ELSE
  495.               IF cury<>maxy THEN
  496.               BEGIN
  497.                 INC(cury);
  498.                 curx:=minx;
  499.               END; { IF }
  500.             GOTOXY(curx,cury);
  501.           END; { 32..126 }
  502.  
  503.           CHR(bs):
  504.           BEGIN
  505.             IF curx<>minx THEN
  506.             BEGIN
  507.               DEC(curx);
  508.               GOTOXY(curx,cury);
  509.               write(CHR(space));
  510.               GOTOXY(curx,cury);
  511.             END;
  512.           END; { bs }
  513.  
  514.           CHR(return):
  515.           BEGIN
  516.             IF cury<>maxy THEN
  517.             BEGIN
  518.               INC(cury);
  519.               curx:=minx;
  520.               GOTOXY(curx,cury);
  521.             END;
  522.           END; { return }
  523.  
  524.           CHR(up):
  525.           BEGIN
  526.             IF cury<>miny THEN
  527.             BEGIN
  528.               DEC(cury);
  529.               GOTOXY(curx,cury);
  530.             END;
  531.           END; { up }
  532.  
  533.           CHR(down):
  534.           BEGIN
  535.             IF cury<>maxy THEN
  536.             BEGIN
  537.               INC(cury);
  538.               GOTOXY(curx,cury);
  539.             END;
  540.           END; { down }
  541.  
  542.           CHR(left):
  543.           BEGIN
  544.             IF curx<>minx THEN
  545.             BEGIN
  546.               DEC(curx);
  547.               GOTOXY(curx,cury);
  548.             END;
  549.           END; { left }
  550.  
  551.           CHR(right):
  552.           BEGIN
  553.             IF curx<>maxx THEN
  554.             BEGIN
  555.               INC(curx);
  556.               GOTOXY(curx,cury);
  557.             END;
  558.           END; { right }
  559.  
  560.         END; { CASE }
  561.         until key=exitchr;
  562.         savewin(wn^.state);
  563.       END; { winedit }
  564.  
  565.       FUNCTION getparm(str: STRING): STRING;
  566.         CONST
  567.         cgetattr= white+cyan*16;
  568.         mgetattr= white+black*16;
  569.         depth=3;
  570.         width=60;
  571.       TYPE
  572.         edbuftype= ARRAY[0..width-2] OF BYTE;
  573.       VAR
  574.         wn: winrecptr;
  575.         oldwin: winstate;
  576.         edbuf: ^edbuftype;
  577.         size: WORD;
  578.         i: INTEGER;
  579.         tstr: STRING;
  580.         attr: INTEGER;
  581.  
  582.       BEGIN { getparms }
  583.         IF lastmode=mono THEN
  584.           attr:=mgetattr
  585.         ELSE
  586.           attr:=cgetattr;
  587.         tstr:='';
  588.         curhelp:= 'Enter Parameter';
  589.         savewin(oldwin);
  590.         openwindow(10,10,10+width-1,10+depth-1,wn);
  591.         tframewin(str,doubleframe,attr,attr);
  592.         fillwin(#32,attr);
  593.         IF lastmode=mono THEN
  594.           textattr:=mgetattr
  595.         ELSE
  596.           textattr:=cgetattr;
  597.         gotoxy(1,1);
  598.         savewin(wn^.state);
  599.         size:=width*(depth-2);
  600.         getmem(edbuf,size);
  601.         FillChar(edbuf^,size,CHR(32));
  602.         winedit(wn,edbuf,size,[CHR(32)..CHR(126)],TRUE,CHR(return));
  603.         Move(edbuf^,tstr[1],width-2);
  604.         tstr[0]:=CHR(width-2);
  605.         WHILE tstr[LENGTH(tstr)]=' ' DO  { strip trailing spaces }
  606.           tstr[0]:= CHR(ORD(tstr[0])-1);
  607.         getparm:= tstr;
  608.         freemem(edbuf,size);
  609.         restorewin(wn^.state);
  610.         unframewin;
  611.         closewindow(wn);
  612.         restorewin(oldwin);
  613.       END; { getparm }
  614.  
  615.     BEGIN { checkforparms }
  616.       { parms take format      stuf  @1"Enter value" @2"enter drive" @2
  617.       { would produce          stuf  value drive drive                     }
  618.  
  619.       FOR i:= 1 TO maxparm DO
  620.         parmactive[i]:=FALSE;
  621.        tstr:= mdatastr[cnt]^;
  622.       { kill leading spaces }
  623.       WHILE (tstr[1]=' ') DO
  624.         tstr:= COPY(tstr,2,LENGTH(tstr)-1);
  625.       tstr2:='';
  626.       WHILE POS('@',tstr)<>0 DO
  627.       BEGIN
  628.         IF POS('@',tstr)>1 THEN
  629.         BEGIN
  630.           tstr2:=CONCAT(tstr2,COPY(tstr,1,POS('@',tstr)-1));
  631.           tstr:=COPY(tstr,POS('@',tstr),LENGTH(tstr));
  632.         END; { use up leading stuff }
  633.         parpos:= POS('@',tstr);
  634.         IF parpos<>0 THEN
  635.         BEGIN
  636.           IF tstr[parpos+1] IN ['1'..'9'] THEN { really a parameter }
  637.           BEGIN
  638.             IF parmactive[ORD(tstr[parpos+1])-48] THEN
  639.             BEGIN { old parameter }
  640.               tstr2:=CONCAT(tstr2,parm[ORD(tstr[parpos+1])-48]);
  641.               tstr:=COPY(tstr,3,LENGTH(tstr)-2);
  642.             END
  643.             ELSE { new parameter }
  644.             BEGIN
  645.                parmactive[ORD(tstr[parpos+1])-48]:= TRUE;
  646.                parm[ORD(tstr[parpos+1])-48]:=
  647.                getparm(CONCAT(' ',COPY
  648.                 (tstr,parpos+3,POS('"',COPY(tstr,parpos+3,LENGTH(tstr)))-1),' '));
  649.                tstr2:=CONCAT(tstr2,parm[ORD(tstr[parpos+1])-48]);
  650.                tstr:= COPY(tstr,
  651.                 POS('"',COPY(tstr,parpos+3,LENGTH(tstr)))+4,LENGTH(tstr));
  652.             END; { ELSE }
  653.           END { really a parameter }
  654.           ELSE
  655.           BEGIN
  656.             tstr2:=CONCAT(tstr2,'@');
  657.             tstr:=COPY(tstr,2,LENGTH(tstr)-1);
  658.           END; { not a parameter }
  659.         END; { posible parameter }
  660.       END; { WHILE }
  661.       { now get tail of string }
  662.       tstr2:=CONCAT(tstr2,tstr);
  663.       FOR k:= 1 TO LENGTH(tstr2) DO
  664.         tstr2[k]:=upcase(tstr2[k]); { convert to upper case }
  665.  
  666.       { its bigger now so re-get space }
  667.  
  668.       FREEMEM(mdatastr[cnt],LENGTH(mdatastr[cnt]^)+2);
  669.       GETMEM(mdatastr[cnt],LENGTH(tstr2)+2);
  670.       mdatastr[cnt]^:= tstr2;
  671.     END; { checkforparms }
  672.  
  673.     PROCEDURE dosubmenu(smen: integer);
  674.     VAR
  675.      i: INTEGER;
  676.      menu: menutype;
  677.      restartmenu: BOOLEAN;
  678.      { 1.520 }
  679.      tstr: STRING;
  680.      v1,v2: INTEGER;
  681.      doingmemory: BOOLEAN;
  682.  
  683.     BEGIN { dosubmenu }
  684.       menu.title:=   mdatastr[menus[smen].strs[0]]^;
  685.       menu.titlehelp:='';
  686.       { 1.520 }
  687.       doingmemory:= memorystr<>'';
  688.       IF doingmemory THEN
  689.       BEGIN
  690.         VAL(COPY(memorystr,1,2),v1,v2);
  691.         memorystr:=COPY(memorystr,3,LENGTH(memorystr)-2);
  692.         IF v2<>0 THEN
  693.         BEGIN
  694.           doingmemory:= FALSE;
  695.           memorystr:= '';
  696.         END { error in memorystr }
  697.         ELSE
  698.         BEGIN { maybe a valid conversion }
  699.           IF (v1 < 1) OR (v1>menus[smen].num) THEN
  700.           BEGIN
  701.             doingmemory:= FALSE;
  702.             memorystr:= '';
  703.           END;
  704.         END; { else maybe valid }
  705.       END; { memorystr being processed }
  706.       FOR i:= 1 TO menus[smen].num DO
  707.       BEGIN
  708.         menu.item[i]:= mdatastr[menus[smen].strs[i]]^;
  709.         menu.itemhelp[i]:='';
  710.       END;
  711.       WITH menu DO
  712.       BEGIN
  713.         numitem:=menus[smen].num;
  714.  
  715.         { 1.520 }
  716.         IF doingmemory THEN
  717.           oldselect:= v1
  718.         ELSE
  719.           oldselect:=1;
  720.         mode:=replace;
  721.         ctrl.sort:= FALSE;
  722.         ctrl.wrap:= TRUE;
  723.         ctrl.escape:= TRUE;
  724.         ctrl.alphakey:= TRUE;
  725.       END; { WITH }
  726.       txtmenuinit(menu,0,0);
  727.       REPEAT
  728.         curhelp:='General';
  729.  
  730.         { 1.520 }
  731.         IF doingmemory AND (memorystr<>'') THEN
  732.           choice:= v1
  733.         ELSE
  734.           choice:= txtmenu(menu);
  735.         savewin(menu.wn^.state);
  736.         IF (choice<>0) THEN
  737.         BEGIN
  738.           STR(choice:2,tstr);
  739.           outputmemorystr:=CONCAT(outputmemorystr,tstr);
  740.  
  741.  
  742.           IF menus[smen].issub[choice] THEN
  743.            dosubmenu(menus[smen].menuidx[choice])
  744.           ELSE
  745.           BEGIN
  746.             {$I-}
  747.             FOR i:= menus[smen].strs[choice]+1 TO menus[smen].strs[choice+1]-1 DO
  748.               checkforparms(i);
  749.             ASSIGN(f,fname);
  750.             IF ioresult<>0 THEN
  751.               error(CONCAT('Unable to Write to:  > ',fname));
  752.             REWRITE(f);
  753.             IF ioresult<>0 THEN
  754.               error(CONCAT('Unable to Write to:  > ',fname));
  755.  
  756.             restartmenu:= TRUE;
  757.             FOR i:= menus[smen].strs[choice]+1 TO menus[smen].strs[choice+1]-1 DO
  758.             BEGIN { 1.510 }
  759.               IF POS('!MC!',mdatastr[i]^)=1 THEN
  760.               BEGIN
  761.                 restartmenu:= FALSE;
  762.                 mdatastr[i]^:= COPY(mdatastr[i]^,5,LENGTH(mdatastr[i]^)-4);
  763.               END;
  764.               IF (NOT restartmenu) AND (i=menus[smen].strs[choice+1]-1) THEN
  765.                 WRITE(f,mdatastr[i]^)
  766.               ELSE
  767.                 WRITELN(f,mdatastr[i]^);
  768.             END; { 1.510 }
  769.  
  770.             { 1.010 use parmastr(0) to get program name and path }
  771.             { 1.002 from WRITELN as dos 5.0 kept on reading in new X.bat }
  772.  
  773.             { 1.520 }
  774.             IF memoryon THEN
  775.             BEGIN
  776.               FOR i:= 1 TO LENGTH(outputmemorystr) DO
  777.                 IF outputmemorystr[i]=' ' THEN
  778.                   outputmemorystr[i]:='0';
  779.               filestr:= CONCAT(filestr,' ',outputmemorystr);
  780.             END;
  781.  
  782.             { 1.510 }
  783.             IF restartmenu THEN
  784.               WRITE(f,CONCAT('@',paramstr(0),' '),filestr);
  785.  
  786.             CLOSE(f);
  787.             IF ioresult<>0 THEN
  788.               error(CONCAT('Unable to Write to  > ',fname));
  789.  
  790.  
  791.             { 1.500 }
  792.             IF logon THEN
  793.               Writelog(mdatastr[menus[smen].strs[choice]]^);
  794.  
  795.  
  796.  
  797.             {$I+}
  798.             selected:= TRUE;
  799.           END;
  800.         END; { choice<>0 }
  801.       restorewin(menu.wn^.state);
  802.     UNTIL (choice=0)  OR selected;
  803.     IF choice=0 THEN
  804.     BEGIN
  805.       choice:= smen;
  806.       { 1.520 }
  807.       outputmemorystr:= COPY(outputmemorystr,1,
  808.                         LENGTH(outputmemorystr)-2);
  809.       choice:=smen;
  810.     END;
  811.     txtmenukill(menu);
  812.     END; { dosubmenu }
  813.  
  814.     PROCEDURE confirmexit;
  815.  
  816.     VAR
  817.       exitmenu: menutype;
  818.       pick: INTEGER;
  819.  
  820.     BEGIN { confirmexit }
  821.        WITH exitmenu DO
  822.        BEGIN
  823.          title:='Exit';
  824.          titlehelp:='';
  825.          item[2]:='Yes';
  826.          itemhelp[2]:='';
  827.          item[1]:='No';
  828.          itemhelp[1]:='';
  829.  
  830.          numitem:=2;
  831.          oldselect:=2;
  832.          mode:=replace;
  833.          ctrl.sort:= FALSE;
  834.          ctrl.wrap:= FALSE;
  835.          ctrl.escape:= TRUE;
  836.          ctrl.alphakey:= TRUE;
  837.        END; { WITH }
  838.        txtmenuinit(exitmenu,0,0);
  839.        pick:=txtmenu(exitmenu);
  840.        txtmenukill(exitmenu);
  841.        IF (pick=0) OR (pick=1) THEN { cancel escape }
  842.          choice:=1; { menu.oldselect; }
  843.     END; { confirmexit }
  844.  
  845.   BEGIN { domainmenu }
  846.     selected:=FALSE;
  847.     REPEAT
  848.       dosubmenu(0);
  849.       IF ((choice=0) AND escapeok) THEN
  850.         confirmexit;
  851.     UNTIL ((choice=0) AND escapeok) OR selected;
  852.     escaped:= (choice=0);
  853.   END; { domainmenu }
  854.  
  855.   {$I- }
  856.   PROCEDURE getinfo;
  857.   VAR
  858.     f: TEXT;
  859.     i,cnt,j,k: INTEGER;
  860.     w: INTEGER;
  861.     tstr,tstr2:STRING;
  862.     ctrlline: BOOLEAN;
  863.  
  864.     PROCEDURE getsubs(menunum: menunumtype);
  865.     VAR
  866.       i,j,k,cnt,tcnt: INTEGER;
  867.       tstr,tstr2,tstr3: STRING;
  868.       notfound: BOOLEAN;
  869.     BEGIN  { getsubs }
  870.       cnt:= menus[menunum].strs[0]+1;
  871.       WHILE (cnt<=numdata) AND (mdatastr[cnt]^[1]<>'%') DO
  872.       BEGIN  { find all menu items }
  873.         IF (mdatastr[cnt]^[1]<>' ') THEN  { must be a menu item }
  874.         BEGIN
  875.           menus[menunum].strs[menus[menunum].num]:=cnt;
  876.           WHILE (mdatastr[cnt+1]^[1]=' ') DO
  877.             mdatastr[cnt+1]^:= COPY(mdatastr[cnt+1]^,2,LENGTH(mdatastr[cnt+1]^)-1);
  878.           menus[menunum].issub[menus[menunum].num]:=(mdatastr[cnt+1]^[1]='%');
  879.           IF menus[menunum].issub[menus[menunum].num] THEN
  880.           BEGIN
  881.             menus[menunum].menuidx[menus[menunum].num]:= totmenu+1;
  882.             { find start of this submenu items menu }
  883.             tcnt:=cnt+2;
  884.             tstr:=mdatastr[menus[menunum].strs[menus[menunum].num]+1]^;
  885.             FOR k:= 1 TO LENGTH(tstr) DO
  886.               tstr[k]:=upcase(tstr[k]);      { convert to all upper case }
  887.             notfound:=TRUE;
  888.             WHILE ((tcnt<=numdata) AND notfound) DO
  889.               IF mdatastr[tcnt]^[1]<>'%' THEN
  890.                 tcnt:=tcnt+1
  891.               ELSE
  892.               BEGIN
  893.                 tstr3:=mdatastr[tcnt]^;
  894.                 FOR k:= 1 TO LENGTH(tstr3) DO
  895.                   tstr3[k]:=upcase(tstr3[k]);  { convert to all upper case }
  896.               notfound:=(POS(tstr,tstr3)=0);
  897.               IF notfound THEN
  898.                tcnt:=tcnt+1;
  899.             END; { WHILE }
  900.             IF tcnt>numdata THEN error(CONCAT('Invalid menu structure:  > ',
  901.               mdatastr[menus[menunum].strs[menus[menunum].num]+1]^));
  902.             totmenu:=totmenu+1;
  903.             menus[totmenu].strs[0]:=tcnt;
  904.             menus[totmenu].num:=1;
  905.  
  906.             { strip location info from menu title}
  907.             IF POS(',',mdatastr[menus[totmenu].strs[0]]^)<>0 THEN
  908.             mdatastr[menus[totmenu].strs[0]]^:=
  909.               COPY(mdatastr[menus[totmenu].strs[0]]^,
  910.               1,POS(',',mdatastr[menus[totmenu].strs[0]]^)-1);
  911.             getsubs(totmenu);
  912.           END; { is sub menu }
  913.           menus[menunum].num:=menus[menunum].num+1;
  914.           menus[menunum].strs[menus[menunum].num]:=cnt;
  915.  
  916.           cnt:=cnt+1; { was menu item and next item was de spaced }
  917.         END; { IF valid item for menu }
  918.         cnt:=cnt+1;
  919.       END; { While cnt }
  920.       menus[menunum].strs[menus[menunum].num]:=cnt;
  921.       IF cnt=numdata THEN
  922.         inc(menus[menunum].strs[menus[menunum].num]);
  923.       menus[menunum].num:=menus[menunum].num-1;
  924.     END; { getsubs }
  925.  
  926.   BEGIN { getinfo }
  927.     ASSIGN(f,filestr); { let DOS try to find it }
  928.     RESET(f);
  929.     IF (IORESULT<>0) THEN
  930.     BEGIN
  931.       { 1.010  DOS could not find it, now  check program directory }
  932.       tstr:=paramstr(0); { get full path and program name }
  933.       i:= LENGTH(tstr)+1;
  934.       REPEAT
  935.         i:= i-1;
  936.       UNTIL (tstr[i]='\');
  937.       tstr:= COPY(tstr,1,i); { now it is just the full path }
  938.       tstr:= CONCAT(tstr,filestr);
  939.       ASSIGN(f,tstr);
  940.       RESET(f);
  941.       IF (IORESULT<>0) THEN
  942.         error(CONCAT('Unable to open menu file:  > ',filestr));
  943.     END;
  944.     { read em all into mdatastr array }
  945.     numdata:=1;
  946.     REPEAT
  947.       READLN(f,tstr);
  948.       FOR i:= 1 TO LENGTH(tstr) DO
  949.         IF (tstr[i]=CHR(09))OR
  950.            (tstr[i]=CHR(175)) THEN {  strip double arrow chr }
  951.                                    { left over due to old menus }
  952.                                    { that used it to indicate subs }
  953.            tstr[i]:= CHR(32);  { convert tab to 1 space }
  954.       numdata:=numdata+1;
  955.       { .711 did not handle lines of blanks correctly }
  956.       IF POS(tstr,blanks)<>0 THEN { it is just blanks }
  957.         numdata:= numdata-1
  958.       ELSE
  959.       BEGIN
  960.         { ptrupdate
  961.           get some space  size of string  }
  962.  
  963.         GETMEM(mdatastr[numdata-1],LENGTH(tstr)+2);
  964.         mdatastr[numdata-1]^:=tstr;
  965.  
  966.       END; { add item }
  967.  
  968.     UNTIL EOF(f);
  969.     numdata:=numdata-1;
  970.     CLOSE(F);
  971.     { 0.716 }
  972.     { 0.800 }
  973.      ctrlline:=  (mdatastr[numdata]^[1]='!');
  974.      escapeok:= TRUE;
  975.      rpcok:= FALSE;
  976.      logon:= FALSE;
  977.      memoryon:= FALSE;
  978.      IF ctrlline THEN
  979.      BEGIN
  980.        IF mdatastr[numdata]^='!' THEN
  981.          escapeok:= FALSE
  982.          { retain for old escape method '!' is no escape }
  983.        ELSE
  984.          escapeok:= (0=POS('!',mdatastr[numdata]^[2])); { !! is escape }
  985.        rpcok:= (0<>POS('R',mdatastr[numdata]^));       { !R is do rpc }
  986.  
  987.        { 1.500 }
  988.        logon:= (0<>POS('L',mdatastr[numdata]^));  { log program launches }
  989.  
  990.        { 1.520 }
  991.        memoryon:= (0<>POS('M',mdatastr[numdata]^)); { menu remembers place }
  992.  
  993.        numdata:=numdata-1;
  994.      END;
  995.     menus[0].num:=1;
  996.     menus[0].strs[0]:=1;
  997.     IF (mdatastr[menus[0].strs[0]]^[1]<>'%') THEN
  998.       error(CONCAT('First line must be menu:  > ',mdatastr[menus[0].strs[0]]^));
  999.  
  1000.         { strip % and location info from menu title}
  1001.     mdatastr[menus[0].strs[0]]^:= COPY(mdatastr[menus[0].strs[0]]^,2,
  1002.       LENGTH(mdatastr[menus[0].strs[0]]^));
  1003.         IF POS(',',mdatastr[menus[0].strs[0]]^)<>0 THEN
  1004.           mdatastr[menus[0].strs[0]]^:=COPY(mdatastr[menus[0].strs[0]]^,
  1005.           1,POS(',',mdatastr[menus[0].strs[0]]^)-1);
  1006.     menus[0].strs[0]:=1;
  1007.     getsubs(0);
  1008.  
  1009.     FOR i:= 1 to numdata DO  { strip leading % from all strings }
  1010.       IF   mdatastr[i]^[1]='%' THEN
  1011.         mdatastr[i]^:= COPY(mdatastr[i]^,2,LENGTH(mdatastr[i]^)-1);
  1012.     FOR i:= 0 to totmenu DO
  1013.     BEGIN
  1014.       w:=1;
  1015.       { now put markers on end of items with submenus. }
  1016.       FOR k:= 0 TO menus[i].num DO
  1017.         w:=max(w,LENGTH(mdatastr[menus[i].strs[k]]^));
  1018.       FOR k:= 1 TO menus[i].num DO
  1019.       BEGIN
  1020.         IF menus[i].issub[k] THEN
  1021.         BEGIN
  1022.           tstr2:=mdatastr[menus[i].strs[k]]^;
  1023.           FREEMEM(mdatastr[menus[i].strs[k]],
  1024.              LENGTH(mdatastr[menus[i].strs[k]]^)+2);
  1025.           tstr2:=CONCAT(tstr2,COPY(blanks,1,w-LENGTH(tstr2)),' »');
  1026.           GETMEM(mdatastr[menus[i].strs[k]],LENGTH(tstr2)+2);
  1027.           mdatastr[menus[i].strs[k]]^:=tstr2;
  1028.         END;  { is sub }
  1029.       END; { K }
  1030.     END; { I }
  1031.   END; { getinfo }
  1032.   {$I+ }
  1033.  
  1034.   PROCEDURE initalize;
  1035.   VAR
  1036.     i: INTEGER;
  1037.     s1: STRING;
  1038.  
  1039.   BEGIN  { initalize }
  1040.     GETINTVEC(250,oldhelpvec);
  1041.     SETINTVEC(250,@help);
  1042.     helpon:= TRUE;
  1043.     delay(10);
  1044.  
  1045.     { .712 }
  1046.     reg.AH:= 01;
  1047.     reg.CH:= $20;
  1048.     reg.CL:= 08;
  1049.     INTR($10,reg);   { Turn cursor off }
  1050.  
  1051.     { 0.713 }
  1052.     reg.AX:= 00;
  1053.     INTR($33,reg);   { check for mouse and reset }
  1054.     hasmouse:= (reg.ax=$FFFF);
  1055.  
  1056.     { 0.714 }
  1057.     reg.AX:=$3000;
  1058.     INTR($21,reg); { get dos version }
  1059.     IF reg.AL<03 THEN
  1060.       error('Requires DOS version 3.00 or greater.');
  1061.  
  1062.     STR(reg.AL:1,dosverstr);
  1063.     STR(reg.AH:2,s1);
  1064.     FOR i:= 1 TO LENGTH(s1) DO
  1065.       IF s1[i]=' ' THEN
  1066.         s1[i]:='0';
  1067.     dosverstr:=CONCAT(dosverstr,'.',s1);
  1068.     { 0.715 } { find PSP and figure out this programs name. }
  1069.     reg.AH:=$62;
  1070.     INTR($21,reg);
  1071.     { reg.BX = segment of psp which is at offset 0 }
  1072.     { more needed to figure out the program name    }
  1073.  
  1074.     clrscr;
  1075.     checkbreak := FALSE;
  1076.     IF lastmode=mono THEN
  1077.       textattr:=lightgray+black*16
  1078.     ELSE
  1079.       textattr := lightgray+blue * 16;
  1080.     RANDOMIZE;
  1081.     { get filename from command line or if none on cl then from env var MN }
  1082.     cl:= FALSE;
  1083.     IF paramcount<1 THEN
  1084.       filestr:=getenv('MN')
  1085.     ELSE
  1086.     BEGIN
  1087.       cl:= TRUE;
  1088.       filestr:= paramstr(1);
  1089.     END;
  1090.     { 1.520 }
  1091.     memorystr:= '';
  1092.     IF paramcount>1 THEN
  1093.       memorystr:= paramstr(2);
  1094.     outputmemorystr:= '';
  1095.  
  1096.     { now extend file if it dosent have an extension , use .MNU }
  1097.     IF (POS('.',filestr)=0)AND (filestr<>'') THEN
  1098.       filestr:=CONCAT(filestr,'.MNU');
  1099.     IF (filestr='') THEN
  1100.       filestr:= 'No MN environment';
  1101.  
  1102.     totmenu:=0;
  1103.     getinfo;
  1104.  
  1105.      { 0.729 }
  1106.      blankerstr:=CONCAT(' M C Menu  Ver ',verstr,' ');
  1107.  
  1108.  
  1109.  
  1110.   END; { initalize }
  1111.  
  1112.  
  1113. BEGIN { MCMenu }
  1114.  
  1115.   initalize;
  1116.   titlescreen;
  1117.   window(1,1,80,25);
  1118.   curhelp:='General';
  1119.   escaped:= FALSE;
  1120.  
  1121.   domainmenu;
  1122.  
  1123.   window(1,1,80,25);
  1124.   textbackground(black);
  1125.   textcolor(lightgray);
  1126.   clrscr;
  1127.   SETINTVEC(250,oldhelpvec);
  1128.  
  1129.   IF NOT escaped THEN
  1130.   BEGIN
  1131.  { now clear keyboard buffer }
  1132.  WHILE keypressed DO
  1133.    ch:=READKEY;
  1134.  stufkeyp(ORD(fnamechar));
  1135.  stufkeyp(13);    { run batch (fnamechar).bat which runs mcmenu when done. }
  1136.  END; { NOT escaped }
  1137.   { .712 }
  1138.   textmode(lastmode); { turn cursor on  }
  1139. END . { MCMenu }
  1140.